C**** CLEFS.F4 ****
COPYRIGHT 1983 BY LELAND SMITH
C**** CLEFS, ROTSAV, GETLIB, MOVER, CLIP, IBOTH, CLP

	SUBROUTINE CLEFS
C**** 2/14/83  THIS FORM SHOULD HOLD ALL TYPE FONTS AND 'CLEF' FILES IN CORE.
C**** NOW HOLDS 50 LIBE. FILES ALWAYS + 5 FOR USER.
C**** JCLEF(14000) =C.55*250    LIBNUM=55  NPT(LIBNUM+2) NAM(LIBNUM+1)
C**** JCLMAX =14000  JPMAX= 55*10 = 550 ++++ MAX VECTS IN SINGLE ITEM=500
C**** KPT(JPMAX+10)
C**** IF CHANGES, FIX DIMENSIONS AND DATA (LIBNUM)
	DIMENSION JCLEF(14000),NAM(56),NPT(57),KPT(560),CM(4)
	COMMON /LIBE/KNM,JCLMAX,JPMAX,LIBNUM,JPT,NM
	COMMON /STF/RSTFAC(8),RSTJ2 /PLTR/IPLT,RHT,DIS,XDIS/BM/F,G,H
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /MIN/MINI,RMINI/DST/DS,DX
	1/RINC/RINC
C  RINC=FILLER INCREMENT (1.0 WHEN PRINTING)
	DATA LIBNUM/55/,JCLMAX/14000/,JPMAX/550/,NPT(1)/1/,KPT(1)/1/,
	1 RINC/4.0/,CM/.1,1.5,1.1,1.5/,XDIS/1.0/
	EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J9,JQ(7))
	1,(R6,RJQ(4)),(R5,RJQ(3)),(R8,RJQ(6)),(R7,RJQ(5)),(J8,JQ(6))
	2,(DEG,R9,RJQ(7)),(NJR,RJQ(8)),(R3,RJQ(1))
	3,(R11,RJQ(9)),(R12,RJQ(10))
	IF(R6.GE.100)R6=R6-100
C SOMETIMES MAKE SIZE +100 FOR PARTS PROGRAM.
	CALL NOZERO(R6)
	IF(R7.EQ.0)R7=R6
C  IF P7 = 0, IT WILL EQUAL P6.
	IF(JA.GT.10)GO TO 10
	NAME='CLEFA'
	IF(J5.LT.20)GO TO 40
	R6=R6*.3
C  SIZE FACTORS FOR SPECIAL WORDS, ETC. (PPP, MF, CRESC. ETC.)
	R7=R7*.3
	GO TO 40
10	IF(NAME.EQ.NJR)GO TO 40
	IF(NAME.EQ.0)GO TO 20
	IF(NJR.EQ.0)GO TO 40
20	IF(NJR.EQ.0)GO TO 30
C  TO PICK UP BASIC DRAW NAME FROM P10
	NAME=NJR
	GO TO 40
30	CALL TYPSTR('SET P10=1')
	CALL TYPCRLF
C  LEADS TO PROPER FILE CALL
40	JTAIL=-1
	IF(JA.NE.3)GO TO 50
	IF(R5.NE.0.8)GO TO 50
	JTAIL=0
C R5=0.8 FOR TREBLE CLEF WITH 8 ON TAIL. (FOR TENOR VOCAL)
50	NM=NAME+2*(J5/10)
C  DRAW0 HAS ITEMS 0↑Y9;  DRAW1, 10↑Y19; ETC. TO DRAW9, 90↑Y99
	JEZ=MOD(J5,10)+1
60	DO 70 KNM=1,LIBNUM
C***** LIBNUM IS NUMBER OF POSSIBLE LIBE FILES.
70	IF(NM.EQ.NAM(KNM))GO TO 110
C  SET P10~0 TO CHANGE BASIC 'DRAW' NAME.
C  JUMP IF ALREADY IN CORE
	NPP=0
	IF(JA.NE.11)GO TO 90
C  DOESN'T CHECK LOOKUP ON CLEFS AND ALPHA'S.
	NPP=-1
	IF(LOOKF(NM).LT.0)GO TO 90
	IF(LOOKL(NM).LT.0)GO TO 100
C IF .LIB IS FOUND, GO TO 100
	CALL TYPWRD(NM)
	CALL TYPSTR(' -- NOT FOUND')
80	CALL TYPCRLF
	RETURN
90	CALL GETFI2(NM,NPP)
	IF(NPP.LE.0)GO TO 100
	CALL TYPWRD(NM)
	CALL TYPSTR('.DMD  NOT FOUND*****')
	GO TO 80

100	CALL GETLIB(JCLEF,NAM,NPT,KPT)
C GETS LIBRARY FILES.  CHECKS FOR OVERFLOW. SHUFFLES IF NECESSARY.

110	IF(J5.GT.3)GO TO 130
	IF(JA.NE.3)GO TO 130
C  0=TREB, 1=BASS, 2=ALTO, 3=TENOR(ALTO SHIFTED UP)
C  ↑↑↑↑↑↑↑↑  FIXUP SOMEDAY IN .DMD FILES
	IF(IABS(J4).LT.80)GO TO 120
	RSTJ2=.8*RSTJ2
C  TO SET HGT. OF MINI CLEFS
	R4=R4+CM(JEZ)
C  SHIFTS MINIS UP BECAUSE OF WRONG ORIG. POS.??
120	IF(JEZ.NE.4)GO TO 130
	R4=R4+2
	JEZ=3
C   ABOVE IS NOW AT TOP

130	A=R4
	R4=A+2.9
C  ADJUSTS HEIGHT(??)
	CALL CENTX
	R4=A
	JROT=0
C JROT.NE.0 = ROTATION

	N=NPT(KNM)+JEZ-1
	IF(N.LT.JPT)GO TO 150
C POINTER IS OUT OF DATA RANGE.
C JUMP IF THERE IS REALLY SOMETHING THERE.
140	CALL TYPINT(J5)
	CALL TYPSTR(' NOT FOUND *******')
	CALL TYPCRLF
	GO TO 240
C CATCHES IMPOSSIBLE NUMBERS (I HOPE!)
150	L=KPT(N)
C NOW L = POINTER IN JCLEF ARRAY FOR THIS ITEM.
   	IF(J9.EQ.0)GO TO 170
C***** ROTATE *******
	JROT=-1
	R7=R7*RSTJ2
	R6=R6*RSTJ2
	N=JCLEF(L)
	CALL ROTSAV(JCLEF(L),0)
C GO SAVE THE ORIGINAL FORM OF THIS ITEM.
	DO 160 K=L+1,N+L-1
	CALL UNPACK(J,M,JCLEF(K))
	X=J*R6
	Y=M*R7
	JJ=JCLEF(K)/100000000
	AX=ATAN2(X,Y)*57.29578
	HYP=SQRT(X**2+Y**2)
	ROT=DEG+AX
	J=ROFF(HYP*COSD(ROT))
	M=ROFF(HYP*SIND(ROT))
C	KNT=KNT+1
	IF(J.LT.0)J=1000-J
	IF(M.LT.0)M=1000-M
160	JCLEF(K)=M*10000+J+JJ*100000000
C PACK ROTATED FORM OF POINT
	R6=1.
	R7=1.
	RSTJ2=1.
C  SIZE CHANGES MUST BE MADE BEFORE ROTATION!!!!! ELSE IT DISTORTS.
C  R9=P9=DEGREES OF ROTATION (0-360)
170	A=-1
C  FLAG FOR THICKNESS OR NO.
	IF(J8.EQ.-2)GO TO 210
	IF(R8.LE.0)GO TO 180
	A=0
	CALL THICK
C THICK RETURNS NUMBER OF THICKNESSES IN J8 AND "SCALED" STEP IN R8
C NEXT J8 = 1↑Y99 =X THICKNESS, =100↑Y = Y THICKNESS
CC	J9=J8/100
CC	J4=-1
C FLAG FOR SINGLE ADDED VERTICAL THICKNESS, NO MATTER WHAT SIZE. R8=.5
CC	R8=AMOD(R8,100.0)
CC	J8=R8
CC	IF(R8.NE.J8)J4=0
CC	R9=RSTJ2*DIS
C  R8 AND R9 ARE FACTORS TO CAUSE RIGHT NUM OF LINES FOR THICKNESS.
CC	J8=J8*R9
CC	J9=J9*R9
CC	IF(J9.NE.0.AND.J8.NE.0)J9=J8
C  IF BOTH X AND Y THICKNESS IS USED THEY WILL BECOME EQUAL!
CC	R8=1/DIS
CC	IF(J4)GO TO 32
CC	J9=1
C SINGLE ADDED THICKNESS, NO MATTER WHAT SIZE.
CC	R8=1
	GO TO 210
180	IF(IPLT)GO TO 190
	IF(J8.NE.-1)GO TO 210
C			J8=-2 OMITS FILLER DURING PLOT
190	IF(R11.LT.0)GO TO 210
C  R11 AND R12 MIGHT HAVE DISTORTION PARAMS.
	DS=R11
	DX=R12
	DO 200 K=L+1,JCLEF(L)+L-1
	IF(JCLEF(K).LT.200000000)GO TO 200
	JEZ=JCLEF(L)-1
	IF(K.GT.L+1)JEZ=JEZ-K+L+1
	CALL FILLMS(JEZ,JCLEF(K),R3,CENTR,R6,R7)
	GO TO 210
200	CONTINUE
C  FILLS ONLY WHEN PLOTING OR R8=-1
210	CALL JDRAW(JCLEF(L),R3,CENTR,RSTJ2,R6,R7)
C   3,POS.,STF,NT# OR CLEF,ITEM#,SIZEX,SIZEY, R8=-1 TO FILL ON CRT
	IF(A.LT.0)GO TO 240
	IF(J8.NE.0)GO TO 220
	IF(J9.EQ.0)GO TO 240
	GO TO 230
220	J8=J8-1
	R3=R3+XDIS
C XDIS = 1 PLOTTER STEP
230	IF(J9.EQ.0)GO TO 210
	J9=J9-1
	CENTR=CENTR+XDIS
	GO TO 210
240	IF(JROT.NE.0)CALL ROTSAV(JCLEF(L),-1)
C IF ROTATED, GET BACK ORIGINAL FORM OF ITEM.
	IF(JTAIL.LT.0)RETURN
	JTAIL=-1
	JA=10
	JEZ=9
C  JEZ=9 MAKES AN 8 APPEAR UNDER TAIL OF TREBLE CLEF.
	R6=.2
	R7=R6
	NM='BDR40'
	R3=R3+14*RSTJ2
	R4=-4
	GO TO 60
	END

	SUBROUTINE ROTSAV(J,M)
	DIMENSION J(1)
	COMMON /RINP/JR(500)
CX	COMMON /ROT/JR(500)
C  SHARE THIS ARRAY SOMEWHERE ELSE??
	IF(M.NE.0)GO TO 1
C NOW SAVE DATA
	DO 2 K=1,J(1)
2	JR(K)=J(K)
	RETURN
1	DO 3 K=1,JR(1)
C GET BACK ORIGINAL
3	J(K)=JR(K)
	END

	SUBROUTINE GETLIB(JCLEF,NAM,NPT,KPT)
C GETS LIBRARY FILES.  CHECKS FOR OVERFLOW. SHUFFLES IF NECESSARY.
	DIMENSION JCLEF(1),NAM(1),NPT(1),KPT(1)
  	COMMON /RINP/KPNT(11)
CX	COMMON /ROT/KPNT(11)
CC	COMMON /ALF/NM,KPNT(11),N,NN,NNN,KK,L,K,LL
	COMMON /LIBE/KNM,JCLMAX,JPMAX,LIBNUM,JPT,NM
	DATA KJP/1/,JPT/1/,KX/0/
100	KNM=KX+1
	NAM(KNM)=NM
	CALL FASTI2(KPNT,11)
C GET LIBE FILE WD COUNTS
	NJP=KJP
C NJP=START OF THIS INPUT OF JCLEF DATA
	KJP=KJP+KPNT(11)
C POINT TO SPOT FOR INPUT TO JCLEF NEXT TIME AROUND
	L=KPT(JPT)-1
C TOTAL ALREADY IN KPT LIST
	DO 105 N=2,10
	JPT=JPT+1
C UPDATE COUNTER
	IF(KPNT(N).EQ.0)GO TO 106
C JUMP OUT IF FILE HAS LESS THAN 10 ITEMS
	IF(KPNT(N).GT.KPNT(N-1))GO TO 105
	KPNT(N)=KPNT(11)
C DRAW PROGRAM SOMETIMES DOESN'T GIVE WD COUNT OF LAST ITEM
	GO TO 106
105	KPT(JPT)=L+KPNT(N)
C UPDATE JCLEF POINTER LIST
	JPT=JPT+1
	N=11
106	KPT(JPT)=KPNT(11)+L+1
C POINT TO NEXT FREE SPACE IN JCLEF
	NPT(KNM+1)=NPT(KNM)+N-1
C UPDATE POINTER TO POINTER LIST
	KX=KNM
C KJP=POINT TO START NEXT LIBE. FILE
C 2/14/83 **** NOW RESERVES LAST 5 SLOTS FOR USER LIBE .DMD FILES ****
104	IF(KX.LE.LIBNUM.AND.KJP.LE.JCLMAX.AND.JPT.LE.JPMAX)GO TO 107
	L=KX-6
C ROTATE DATA IN LAST 5 AREAS
	N=NPT(L)
	NN=NPT(L+1)
	NNN=NN-N
C NNN=NUM OF ITEMS IN DELETED LIBE.
	KK=KPT(NN)-KPT(N)
C KK= NUM OF DATA ELEMENTS TO DELETE
	JPT=JPT-NNN
	NJP=NJP-KK
C NJP POINTS TO START OF NEXT LIBE IN JCLEF.
	KJP=KJP-KK
C KJP POINTS TO START NEXT TIME AROUND.
	LL=KPT(NPT(KX+1))
	IF(LL.GT.JCLMAX)LL=JCLMAX
	DO 101 K=KPT(N),LL
CC	DO 101 K=KPT(N),KPT(NPT(KX+1))
C SHIFT DATA
101	JCLEF(K)=JCLEF(K+KK)
	LL=NPT(KX+1)
	IF(LL.GT.JPMAX)LL=JPMAX
	DO 103 K=N,LL
CC	DO 103 K=N,NPT(KX+1)
C SHIFT POINTERS TO DATA
103	KPT(K)=KPT(K+NNN)-KK
	DO 102 K=L,LIBNUM+1
	NPT(K)=NPT(K+1)-NNN
	NNM=NAM(K+1)
C SHIFT LIBE FILE NAMES
102	NAM(K)=NNM
	KX=KX-1
	KNM=KNM-1
C ALL POINTERS RESET, GO BACK AND CHECK AGAIN.
	GO TO 104
107	CALL FASTI2(JCLEF(NJP),KPNT(11))
C GETS LIBRARY AND PUTS IT IN RIGHT SLOT
	END

	SUBROUTINE MOVER
	IMPLICIT INTEGER(A-Q,S-Z)
	DIMENSION IR(2,250)
	REAL POS,EXTEN,PRCNT,ACCX
CCCC	COMMON/RINP/R(500),NO(400)  /MKX/KSLA,ISEMI,LESS,IGT
C TOTAL SIZE OF /RINP/ IS SET IN MS.F4  (NO(n) IS ALL THAT IS USED HERE)
	COMMON/RINP/R(2,250),NO(400),NP(400)  /MKX/KSLA,ISEMI,LESS,IGT
C ARRAY NO(X) USED IN 'MOVIT'. HOLDS ALL POINTS TO BE MOVED AT ANY TIME.
	COMMON/FRMT/F78F(1),FONE(1),FA5(1),ASK/STF/RSTFAC(0/7),RSTJ2
	1 /A2Z/LAA,LBB,LCC,A1(6),LJJ,LKK,LEL
CJST	COMMON/XRN/RN(1) /KJY/ KY,JY /IDEV/IDEV
	COMMON/XRN/RN(1) /KJY/ KY,JY  /JSTFY/ROV,PRCNT,RJSZ /IDEV/IDEV
	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
	1 /POSI/STFF(0/7),JJ2,POS /LIMIT/LIMIT,ITEM,LL,I,IX/PTR/PWDS(1)
	2 /ALF/INP(46),ACCX,ML,RRT,RZRO,NCNT,JSZ,OV,RSPC,KN,RA,RB,
	3 JLDGR,LDGR,JX,RW,RX,RY,RZ,JJ,RD,RQ,RE,RZZ,RN3,RN6,RV,RQ6
	EQUIVALENCE (R5,RJQ(3)),(R6,RJQ(4)),(R7,RJQ(5)),(R4,RJQ(2))
	1,(R3,RJQ(1)),(R8,RJQ(6)),(R9,RJQ(7)),(R11,RJQ(9))
	2,(IR,R),(I2,INP(2))
CJST	2,(I2,INP(2))
	DATA F78F/'(78F)'/,FONE/'(A1 )'/,FA5/'(A5 )'/

	JJ2=999
	J2=0
	ASK=-1
C  99=BACKUP
CRR***10	CALL VLINE(R2,R4,R5,R6)
10	CALL VLINE(R2,R3,R4,R5)
	R6=R5
	R5=R4
	R4=R3
CC CRR*** CHANGE R4,5,6 LATER *****10   CALL VLINE(R2,R4,R5,R6)
	IF(R2.GE.99)RETURN
	IF(INP(1).EQ.LJJ)GO TO 110
CCC167  TYPE 5
20	IF(IDEV.EQ.5)
	1 CALL TYPSTR('TYPE NEW STAFF #, POS1, POS2, UP-DOWN # ')
CCC5	FORMAT(' TYPE NEW STAFF #, POS1, POS2, UP-DOWN #  '$)
	READ(IDEV,F78F,END=100)R7,R8,R9,R11
CQQ	ACCEPT F78F,R7,R8,R9,R11
	IF(R7.LT.99)GO TO 21
	R4=0
	GO TO 10
21	IF(INP(1).NE.LCC)GO TO 1
	IF(R2.GT.7.OR.R7.LE.7)GO TO 1
	IF(R6.EQ.0)GO TO 20
C NOW WILL COPY ONE CODE NUM TO ALL OTHER ACTIVE STAVE.
	CALL CPYALL
	RETURN
1	IF(R2.LE.7.AND.R7.GT.7)GO TO 20
C  TRY AGAIN IF CONFUSION.
	RDIS=0
	REREAD FONE,L
C FOR LPEN TYPE 'L'. BUT 4TH # MUST APPEAR WHEN NEEDED.
	IF(L.EQ.LESS)GO TO 100
C < RETURN TO TTY MODE
	IF(L.NE.IGT)GO TO 30
	IDEV=1
	GO TO 20
30	IF(L.EQ.LBB)GO TO 10
	IF(R2.GT.7)R7=R2
	IF(R7.EQ.R2)GO TO 40
	IF(IDEV.EQ.1)GO TO 40
	CALL TYPSTR('MOVED TO STAFF ')
	CALL TYPFLT(R7)
	CALL TYPCRLF
CCC	IF(R7.NE.R2)TYPE 1200,R7
40	IF(L.NE.LEL)GO TO 60
	DO 50 K=1,2
	R8=RY
	CALL LPEN(R7,RY,RX)
50	IF(R7.GE.99)GO TO 10
	R9=RY
CC66	JJ2=1
60	NST=1
C  FOR START OF LOOP (1 UNLESS USING COPYIT)
	IF(INP(1).NE.LCC)GO TO 70
	NST=ITEM+1
	CALL COPYIT
70	IF(R11.NE.0)CALL UPDN(NST)
	JJ=0
	IF(R4.NE.R8.OR.R5.NE.R9)JJ=-1
	JY=0
C  JY IS CHANGED IN GETPTS
	IF(JJ)CALL GETPTS(NST)
	IF(R2.NE.R7)CALL STFCH
	IF(JY.NE.0)GO TO 90
80	IF(JJ2.EQ.999)JJ2=-1
	RETURN
CC	IF(JY.EQ.0)RETURN
90	CALL MOVIT(RN,NO,R4,R5,R8,R9)
	RETURN
100	IDEV=5
	GO TO 20
110	IF(R4.EQ.0)R4=.001
	IF(R5.EQ.0)R5=200
	IF(I2.NE.'T')GO TO 115
	IF(R2.GT.7.)RETURN
	CALL JUSTXT(R2,R4,R5)
C 'JT' GO JUSTIFY TEXT.  ONLY 1 STAFF AT A TIME
	RETURN	
115	NCNT=0
	RRT=R5
	RZRO=R4
	RJSZ=4.5
	CALL GETPTS(1)
CJST115	CALL GETPTS(1)
	IF(JY.EQ.0)GO TO 80
C RETURN IF NO ITEMS FOUND TO DEAL WITH.
	ROV=RRT
	PRCNT=1.
	R6=0
	R11=0
120	IF(NCNT.GT.9)GO TO 140
	RJSZ=RJSZ-.06
	RP=PRCNT
	NCNT=NCNT+1
C  TEMPORARY COUNTER
	CALL TYPINT(NCNT)
	CALL TYPCHR('  ',2)
CCC	TYPE F78F,RCNT
	CALL JUSTFY(7,R,IR,NO,NP,RN,RSTFAC,R2,R4,R5,R6,R8,R9)
CJST	CALL JUSTFY(7,ITEM,PWDS,NO,RN,RSTFAC,R2,R4,R5)

130	IF(ROV.LE.RRT+.01)GO TO 150
	IF(RJSZ.GT.4)RJSZ=4
	PRCNT=(ROV-RZRO)/(RRT-RZRO)
	IF(PRCNT.NE.RP)GO TO 120
C  GO BACK AND EXPAND SOME MORE
140	R4=RZRO
	R5=ROV
	R8=RZRO
	R9=RRT-.001
C  JUSTIFYING SPACE DIMINISHES EACH TIME AROUND.
	CALL MOVIT(RN,NO,R4,R5,R8,R9)
C  RVX SHOULD BE FARTHEST POINT TO RIGHT.
CCC1200 FORMAT(' MOVED TO STAFF ',F4.0/)
	CALL HYDPOG(3)
150	CALL TYPCRLF
	END

	SUBROUTINE CLIP(J,K,L)
	COMMON /JCLIP/JCLIP	
C ASSUMES N IS INITIALIZED =0
	IF(L.NE.3)GO TO 1
CC	DATA IX/511/,IY/511/
	IF(IABS(J).GT.JCLIP)GO TO 40
	IF(IABS(K).GT.JCLIP)GO TO 40
C NOW INBOUNDS
	N=0
	CALL AIVECT(J,K)
	GO TO 4
1	IF(N.EQ.0)GO TO 11
C JUMP IF LAST POINT WAS IN BOUNDS
	IF(IABS(JJ).LE.JCLIP)GO TO 6
C NOW JJ IS OUT OF BOUNDS, CLIP IT
5	IF(IBOTH(J,JJ).EQ.0)GO TO 4
C GO BACK IF ENTIRE SEGMENT IS OUT OF BOUNDS
	CALL CLP(JJ,KK,J,K,JJ,KK)
C CLIP FROM INVIS VECT WHICH IS OUT OF BOUNDS
	IF(IABS(KK).LE.JCLIP)GO TO 10
C CLIP MORE IF OTHER POINT IS ALSO OUT.
6	IF(IBOTH(K,KK).EQ.0)GO TO 4
	CALL CLP(KK,JJ,K,J,KK,JJ)
10	CALL AIVECT(JJ,KK)
	N=0
11	IF(IABS(J).GT.JCLIP)GO TO 7
	IF(IABS(K).GT.JCLIP)GO TO 8
9	CALL AVECT(J,K)
4	JJ=J
	KK=K
C REMEMBER THE COORDS.
	RETURN
7	CALL CLP(JX,KX,JJ,KK,J,K)
	IF(IABS(KX).LE.JCLIP)GO TO 12
	CALL CLP(KX,JX,KK,JJ,KX,JX)
12	CALL AVECT(JX,KX)
40	N=-1
	GO TO 4
8	CALL CLP(KX,JX,KK,JJ,K,J)
	GO TO 12
	END

	FUNCTION IBOTH(J,JJ)
	COMMON /JCLIP/II
	IBOTH=0 
	IF(JJ.GE.II.AND.J.GT.II)RETURN
	IF(JJ.LE.-II.AND.J.LT.-II)RETURN
	IBOTH=-1
	END

	SUBROUTINE CLP(JX,KX,JJ,KK,J,K)
	COMMON /JCLIP/II
C JJ,KK=OLD POINT    J,K=NEW POINT  JX,KX=CLIPPED
	JX=II 
	IF(J.LT.-II)JX=-JX
	IF(KK.NE.K)GO TO 1
	KX=KK
	RETURN
1	KX=KK+(K-KK)*(JX-JJ)/(J-JJ)
	END